Function CPFValido(CPF As String) As Boolean
On Error GoTo Err_
'Desenvolvido por Thomas Jefferson Pereira Lopes (redcatmetal@aol.com)
'Baseado no artigo de --{[CRK]}-- (Email:thereverser@hotmail.com) Publicado em www.txt.org

If (Len(CPF) < 14) Or (CPF = "") Then
CPFValido = False
Exit Function
End If

Dim A, B, C, D, E, F, G, H, I, X, Y, R1, R2, Rst1, Rst2, Subst1, Subst2 As Integer

A = CInt(Left(CPF, 1))
B = CInt(Mid(CPF, 2, 1))
C = CInt(Mid(CPF, 3, 1))
D = CInt(Mid(CPF, 5, 1))
E = CInt(Mid(CPF, 6, 1))
F = CInt(Mid(CPF, 7, 1))
G = CInt(Mid(CPF, 9, 1))
H = CInt(Mid(CPF, 10, 1))
I = CInt(Mid(CPF, 11, 1))
X = CInt(Mid(CPF, 13, 1))
Y = CInt(Mid(CPF, 14, 1))

R1 = A * 10 + B * 9 + C * 8 + D * 7 + E * 6 + F * 5 + G * 4 + H * 3 + I * 2
Rst1 = R1 Mod 11
If (Rst1 = 0) Or (Rst1 = 1) Then
Subst1 = 0
Else
Subst1 = 11 - Rst1
End If

If (X <> Subst1) Then
CPFValido = False
    Exit Function

Else
GoTo TestR2
End If

TestR2:

R2 = A * 11 + B * 10 + C * 9 + D * 8 + E * 7 + F * 6 + G * 5 + H * 4 + I * 3 + X * 2
Rst2 = R2 Mod 11

If (Rst2 = 0) Or (Rst2 = 1) Then
Subst2 = 0
Else
Subst2 = 11 - Rst2
End If

If (Y = Subst2) Then
CPFValido = True
Else
CPFValido = False
End If
Exit Function

Err_:
CPFValido = False
Exit Function
End Function 